home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
Libraries
/
Berkeley DB 1.8.5a
/
Distribute
< prev
next >
Wrap
Text File
|
1994-12-31
|
4KB
|
150 lines
Set DistFolder `Perl -Sx "{0}" "{1}" "{TempFolder}"Distribute.Dup "{2}"` && ∂
"{TempFolder}"Distribute.Dup && ∂
Delete -y "{TempFolder}"Distribute.Dup
Echo '# Clean up afterwards'
Echo Delete -y ∂'"{DistFolder}"∂'
Exit
#!perl
#######################################################################
# Project : Distr -
# File : Distribute - Build a distribution
# Author : Matthias Neeracher
# Started : 29Jun93 Language : MPW Perl
# Modified : 31Jul93 MN Some unpleasant bugs
# 27Dec94 MN Creator fixing, conditional stuffing
# Last : 27Dec94
#######################################################################
($distfile,$dup,$archive) = @ARGV;
$stuffit = 1;
open(DIST, $distfile) || die "$0: Could not open \"$distfile\"";
open(DUP, ">$dup") || die "$0: Could not open \"$dup\"";
print DUP "Echo #\n";
while (<DIST>) {
next if /^\s*$/;
next if /^\s*#/;
undef $atx,$aty;
if (/(.*)AT\s+(\d+)\s*,\s*(\d+)(.*)/) {
($atx,$aty,$_) = ($2, $3, $1 . $4);
}
if (/^\s*STUFFIT\s+(\S+)\s*$/) {
if ($1 eq "OFF") {
$stuffit = 0;
} elsif ($1 eq "ON") {
$stuffit = 1;
}
} elsif ( /^\s*CREATOR\s+(\S+)\s+(\S+)\s*$/
|| /^\s*CREATOR\s+\"([^"]+)\"\s+(\S+)\s*$/
|| /^\s*CREATOR\s+(\S+)\s+\"([^"]+)\"\s*$/
|| /^\s*CREATOR\s+\"([^"]+)\"\s+\"([^"]+)\"\s*$/
) {
$creator{$1} = $2;
} elsif (/^\s*TARGET\s+\"([^"]+)\"\s*$/ || /^\s*TARGET\s+(\S+)\s*$/) {
$target = $1;
$target = ":$target" unless ($target =~ /^:/);
$target = "$target:" unless ($target =~ /:$/);
$target =~ /^:?([^:]+)/;
$distfolder = $1;
&mkdirs($target);
# print DUP "SetFile \'$target\' -l $atx,$aty\n" if (defined $atx);
} elsif ( /^\s*\"([^"]+)\"\s+AS\s+\"([^"]+)\"\s*$/
|| /^\s*\"([^"]+)\"\s+AS\s+(\S+)\s*$/
|| /^\s*(\S+)\s+AS\s+(\S+)\s*$/
) {
&linkfile($1, "$target$2", 0);
} elsif (/^\s*\"([^"]+)\"\s*$/ || /^\s*(\S+)\s*$/) {
&linkfiles($1, $target);
} else {
print STDERR "File \"$distfile\"; Line $. # Syntax Error\n";
}
}
if ($stuffit) {
print DUP "Stuff -r \'$distfolder\' -o \'$archive\'\n";
print DUP "Delete -y \'$distfolder\'\n"
}
print "\"$distfolder\"\n";
sub mkdirs
{
local($dir) = @_;
if (!-d $dir) {
if ($dir =~ /(.*:)[^:]+:/) {
&mkdirs($1);
}
mkdir($dir, 0777) || die "Couldn't create directory \"$dir\"";
}
}
sub linkfile
{
local($from,$to,$linkem) = @_;
($origcreator, $origtype) = &MacPerl'GetFileInfo($from);
$creator = $creator{$origtype};
if (defined($creator) && $creator eq $origcreator) {
undef $creator;
}
print STDERR "\t\t\t$from -> $to\n";
if ($to =~ /(.*):Icon∂n$/) {
print DUP "SetFile -a C \'$1\'\n";
}
unlink $to if (-e $to);
if ($linkem && $stuffit && !defined($creator)) {
$from =~ s/∂n/\n/g;
$to =~ s/∂n/\n/g;
symlink($from, $to) || die "Couldn't link \"$from\" to \"$to\"";
} else {
$from =~ s/∂n/\'∂n\'/g;
$to =~ s/∂n/\'∂n\'/g;
print DUP "Duplicate -y \'$from\' \'$to\'\n";
print DUP "SetFile -c \'$creator\' \'$to\'\n" if defined($creator);
}
}
sub linkfiles
{
local($from,$target) = @_;
if ($from =~ /^(.*):([^:]+)$/) {
($fromdir,$fromfile) = ($1,$2);
} else {
($fromdir,$fromfile) = (":",$from);
}
if ($fromfile =~ /[≈?]/) {
$fromfile =~ s/\./\\./;
$fromfile =~ s/≈/.*/;
$fromfile =~ s/\?/./;
opendir(FROMDIR, $fromdir) || "Could not open \"$fromdir\"";
while ($from = readdir(FROMDIR)) {
next unless $from =~ /^$fromfile$/;
&linkfile("$fromdir:$from", "$target$from", 1);
}
} else {
&linkfile($from,"$target$fromfile", 1);
}
}